home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / math.swg / 0077_Math Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-25  |  61.9 KB  |  1,240 lines
  1. {
  2. From: Martin Preishuber <martin_p@efn.efn.org>
  3.  
  4. mycalc.pas that is a unit with mathematical function. the numbers
  5.   are based on 65536, so you can calculate with really
  6.   huge numbers.
  7. rabin.pas it's a demo program for mycalc. you can test large
  8.   number,s whether it is a prime or not
  9.  
  10. both programs are documented in german, so i guess that documentation
  11. won't help much :-(
  12. }
  13.  
  14. (* ----------------------------------------------------------------------- *)
  15. (* RabinTest prüft, ob eine Zahl eine Primzahl ist                         *)
  16. (* ----------------------------------------------------------------------- *)
  17.  
  18. {$M 65000, 0, 655360}                          (* Stack auf maximale Größe *)
  19.  
  20. PROGRAM RabinTest;
  21.  
  22. USES Crt,                                         (* Ein/Ausgabefunktionen *)
  23.      Extend,                                (* erweiterte I/O - Funktionen *)
  24.      MyCalc;               (* Funktionen für das Rechnen mit großen Zahlen *)
  25.  
  26. (* ----------------------------------------------------------------------- *)
  27.  
  28. FUNCTION Expt(zahl : Real; hoch : INTEGER) : Real;
  29.     (* Berechnung des Exponenten einer Realzahl (einfach, weil nur für die *)
  30.                                        (* Berechnung von AnzahlTests nötig *)
  31. VAR i     : INTEGER;                                       (* Zählvariable *)
  32.     hilfe : Real;                        (* Hilfsvariable für das Ergebnis *)
  33. BEGIN
  34.   IF hoch = 0 THEN                                         (* Hochzahl = 0 *)
  35.     Expt := 1                                           (* => Ergebnis = 1 *)
  36.   ELSE
  37.     BEGIN
  38.       hilfe := 1;                         (* Ergebnis mit 1 initialisieren *)
  39.       FOR i := 1 TO hoch DO hilfe := hilfe * zahl;
  40.                            (* Zahl hoch mal mit sich selbst multiplizieren *)
  41.       Expt := hilfe;                             (* Ergebnis zurückliefern *)
  42.     END;
  43. END;
  44.  
  45. (* ----------------------------------------------------------------------- *)
  46.  
  47. FUNCTION AnzahlTests(wahrscheinlichkeit : Real) : INTEGER;
  48.         (* ermittelt die Anzahl Tests, welche nötig sind um die gewünschte *)
  49.                                         (* Wahrscheinlichkeit zu erreichen *)
  50. VAR anzahl : INTEGER;                          (* Anzahl der nötigen Tests *)
  51. BEGIN
  52.   anzahl := 0;                              (* Anzahl mit 0 initialisieren *)
  53.   REPEAT
  54.     INC(anzahl);                                    (* Anzahl um 1 erhöhen *)
  55.   UNTIL ((1/(Expt(4,anzahl))) < wahrscheinlichkeit);
  56.                                    (* solange wiederholen, bis W > (1/4)^x *)
  57.   AnzahlTests := anzahl;                       (* Anzahl Tests zurückgeben *)
  58. END;
  59.  
  60. (* ----------------------------------------------------------------------- *)
  61.  
  62. FUNCTION EvenString(zahl : STRING) : BOOLEAN;
  63.                                         (* prüft, on ein String gerade ist *)
  64. BEGIN
  65.   EvenString := NOT Odd(Ord(zahl[Length(zahl)]) - 48);
  66. END;                 (* prüft, ob die letzte Stelle des Strings gerade ist *)
  67.  
  68. (* ----------------------------------------------------------------------- *)
  69.  
  70. FUNCTION Div5(zahl : STRING) : BOOLEAN;
  71.                            (* prüft, ob ein String durch 5 dividierbar ist *)
  72. VAR last : BYTE;                                 (* letzte Stelle von zahl *)
  73. BEGIN
  74.   last := Ord(zahl[Length(zahl)]) - 48;         (* letzte Stelle ermitteln *)
  75.   IF (last = 0) OR (last = 5) THEN     (* Falls letzte Stelle 0 oder 5 ist *)
  76.     Div5 := TRUE                       (* ist die Zahl durch 5 dividierbar *)
  77.   ELSE
  78.     Div5 := FALSE;                                          (* sonst nicht *)
  79. END;                 (* prüft, ob die letzte Stelle des Strings gerade ist *)
  80.  
  81. (* ----------------------------------------------------------------------- *)
  82.  
  83. FUNCTION Div3(zahl : STRING) : BOOLEAN;
  84.                            (* prüft, ob ein String durch 5 dividierbar ist *)
  85. VAR ziffernSumme : WORD;                       (* Ziffernsumme des Strings *)
  86.     laenge       : BYTE;                             (* Laenge des Strings *)
  87.     i            : BYTE;                                   (* Zählvariable *)
  88. BEGIN
  89.   ziffernSumme := 0;                        (* Ziffernsumme initialisieren *)
  90.   laenge := Length(zahl);                   (* Länge des Strings ermitteln *)
  91.   FOR i := 1 TO laenge DO                        (* ZiffernSumme ermitteln *)
  92.     BEGIN
  93.       ziffernSumme := ziffernSumme + (Ord(zahl[i]) - 48);
  94.                                 (* aktuelle Zahl zur Ziffernsumme addieren *)
  95.     END;
  96.   IF (ZiffernSumme MOD 3) = 0 THEN         (* Ziffernsumme durch 3 teilbar *)
  97.     Div3 := TRUE                                (* => Zahl durch 3 teilbar *)
  98.   ELSE
  99.     Div3 := FALSE;                 (* sonst ist Zahl nicht durch 3 teilbar *)
  100. END;
  101.  
  102. (* ----------------------------------------------------------------------- *)
  103. (* Bedingung 1 beim Rabintest: b^v≡1 mod p                                 *)
  104.  
  105. FUNCTION Bedingung1(b, v, p, pMinus1, EINS : CalcStr) : BOOLEAN;
  106. VAR hilfe : CalcStr;                                    (* HilfsCalcString *)
  107. BEGIN
  108.   ExptModCalcStr(b, v, p, hilfe);                   (* b^v mod p berechnen *)
  109.  
  110.   Write('b^v mod p = '); PrintCalcStr(hilfe);
  111.  
  112.   IF EqualCalcStr(hilfe, EINS) THEN                  (* Falls Ergebnis = 1 *)
  113.     Bedingung1 := TRUE                              (* Bedingung 1 erfüllt *)
  114.   ELSE
  115.     IF EqualCalcStr(hilfe, pMinus1) THEN
  116.       Bedingung1 := TRUE                    (* Bedingung 2 mit r=0 erfüllt *)
  117.     ELSE
  118.       Bedingung1 := FALSE;          (* sonst ist Bedingung 1 nicht erfüllt *)
  119. END;
  120.  
  121. (* ----------------------------------------------------------------------- *)
  122. (* Bedingung 2 beim Rabintest: b^(v^(2r)) ≡ -1 mod p                       *)
  123.  
  124. FUNCTION Bedingung2(VAR b, v, u, p, pMinus1, EINS : CalcStr) : BOOLEAN;
  125. VAR r      : CalcStr;                       (* zu durchlaufende Hochzahlen *)
  126.     ZWEI   : CalcStr;            (* konstante CalcString-Darstellung für 2 *)
  127.     hilfe1 : CalcStr;                                   (* HilfsCalcString *)
  128.     hilfe2 : CalcStr;                                   (* HilfsCalcString *)
  129. BEGIN
  130.   InitCalcStr(r);                                      (* r initialisieren *)
  131.   r.stellen := 1;                 (* r hat 1 Stelle, diese ist zu Beginn 0 *)
  132.   r.zahl[1] := 1;    (* r läuft von 1 weg, weil Bedingung mit r=0 schon in *)
  133.                                                (* Bedingung 1 geprüft wird *)
  134.   WordToCalcStr(2, ZWEI);             (* Zahl zwei in CalcString ermitteln *)
  135.   WHILE LessCalcStr(r, u) DO                              (* solange r < u *)
  136.     BEGIN
  137.  
  138.       Write('r = '); PrintCalcStr(r);
  139.  
  140.       ExptCalcStr(ZWEI, r, hilfe1);                       (* 2^r ermitteln *)
  141.       MulCalcStr(hilfe1, v, hilfe2);           (* 2^r mit v multiplizieren *)
  142.       ExptModCalcStr(b, hilfe2, p, hilfe1);    (* b^(v2^r) MOD p berechnen *)
  143.  
  144.       Write('b^(v2^r) mod p = '); PrintCalcStr(hilfe1);
  145.  
  146.       IF EqualCalcStr(hilfe1, pMinus1) THEN         (* Falls Ergebnis = -1 *)
  147.         BEGIN
  148.           Bedingung2 := TRUE;                       (* Bedingung 2 erfüllt *)
  149.           EXIT;
  150.         END;
  151.       AddCalcStr(r, EINS, hilfe2);                       (* r um 1 erhöhen *)
  152.       r := hilfe2;                                    (* r wieder zuweisen *)
  153.     END;
  154.   Bedingung2 := FALSE;                       (* 2. Bedingung nicht erfüllt *)
  155. END;
  156.  
  157. (* ----------------------------------------------------------------------- *)
  158. (* Rabin prüft eine Zahl mit Hilfe des RabinTests                          *)
  159.  
  160. FUNCTION Rabin(primzahl : STRING; anzahl : INTEGER) : BOOLEAN;
  161. VAR p       : CalcStr;                        (* zu untersuchende Primzahl *)
  162.     pMinus1 : CalcStr;                                     (* Primzahl - 1 *)
  163.     EINS    : CalcStr;                            (* konstanter Wert für 1 *)
  164.     u       : CalcStr;                         (* p-1 = 2^u*v (v ungerade) *)
  165.     v       : CalcStr;                         (* p-1 = 2^u*v (v ungerade) *)
  166.     b       : CalcStr;                           (* Basis bei Primzahltest *)
  167.     hilfe   : CalcStr;                                  (* HilfsCalcString *)
  168.     i       : BYTE;                                        (* Zählvariable *)
  169. BEGIN
  170.   StrToCalcStr(primzahl, p);        (* Primzahl ins 65536-System umwandeln *)
  171.   WordToCalcStr(1, EINS);                   (* CalcStringdarstellung von 1 *)
  172.   SubCalcStr(p, EINS, pMinus1);                     (* vom pMinus1 = p - 1 *)
  173.   InitCalcStr(u);                                      (* u initialisieren *)
  174.   u.stellen := 1;                      (* u besitzt 1 Stellen, diese ist 0 *)
  175.   v := pMinus1;                                     (* v ist zu Beginn p-1 *)
  176.   REPEAT
  177.     AddCalcStr(u, EINS, hilfe);                (* 2^u, Potenz um 1 erhöhen *)
  178.     u := hilfe;                                   (* und wieder u zuweisen *)
  179.     Div2CalcStr(v);                                (* v durch 2 dividieren *)
  180.   UNTIL OddCalcStr(v);                      (* solange, bis v ungerade ist *)
  181.  
  182.   Write('p = '); PrintCalcStr(p);
  183.   Write('u = '); PrintCalcStr(u);
  184.   Write('v = '); PrintCalcStr(v);
  185.  
  186.   FOR i := 1 TO anzahl DO                      (* Anzahl Tests durchführen *)
  187.     BEGIN
  188.       RandomCalcStr(p, b);                    (* zufällige Basis ermitteln *)
  189.  
  190.       Write('b = '); PrintCalcStr(b);
  191.  
  192.       IF (Bedingung1(b, v, p, pMinus1, EINS) = FALSE) THEN
  193.                                                     (* 1. Bedingung prüfen *)
  194.         IF (Bedingung2(b, v, u, p, pMinus1, EINS) = FALSE) THEN
  195.           BEGIN                                     (* 2. Bedingung prüfen *)
  196.             Rabin := FALSE;
  197.             EXIT;     (* beide Bedingungen nicht erfüllt => keine Primzahl *)
  198.           END;
  199.     END;
  200.   Rabin := TRUE;                                    (* Rabintest bestanden *)
  201. END;
  202.  
  203. (* ----------------------------------------------------------------------- *)
  204. (* PrimeTest prüft, ob Zahl eine Primzahl ist                              *)
  205.  
  206. FUNCTION PrimeTest(zahl : STRING; anzahlTests : INTEGER; VAR meldung : STRING)
  207. : BOOLEAN;
  208. BEGIN
  209.   IF EvenString(zahl) THEN                 (* Zahl ist durch 2 dividierbar *)
  210.     BEGIN
  211.       PrimeTest := FALSE;                             (* => keine Primzahl *)
  212.       meldung := 'gerade Zahl';                     (* Meldung zurückgeben *)
  213.     END
  214.   ELSE
  215.     IF Div5(zahl) THEN               (* Falls Zahl durch 5 dividierbar ist *)
  216.       BEGIN
  217.         PrimeTest := FALSE;                              (* => keine Primzahl
  218. *)
  219.         meldung := 'Zahl durch 5 dividierbar';      (* Meldung zurückgeben *)
  220.       END
  221.     ELSE
  222.       IF Div3(zahl) THEN                       (* Zahl durch 3 dividierbar *)
  223.         BEGIN
  224.           PrimeTest := FALSE;                         (* => keine Primzahl *)
  225.           meldung := 'Zahl durch 3 dividierbar';    (* Meldung zurückgeben *)
  226.         END
  227.       ELSE
  228.         BEGIN
  229.           IF NOT Rabin(zahl, anzahlTests) THEN  (* Falls Rabintest negativ *)
  230.             BEGIN
  231.               PrimeTest := FALSE;                        (* keine Primzahl *)
  232.               meldung := 'Rabintest';               (* Meldung zurückgeben *)
  233.             END
  234.           ELSE
  235.             PrimeTest := TRUE;                  (* sonst ist Zahl Primzahl *)
  236.         END;
  237. END;
  238.  
  239. (* ----------------------------------------------------------------------- *)
  240. (* Hauptprogramm erledigt die Ein/Ausgabe                                  *)
  241.  
  242. PROCEDURE Hauptprogramm;                (* Hauptprogramm des Primzahltests *)
  243. VAR anzahl             : INTEGER;              (* Anzahl notwendiger Tests *)
  244.     wahrscheinlichkeit : Real;                 (* Fehlerwahrscheinlichkeit *)
  245.     primzahl           : STRING;                  (* zu untersuchende Zahl *)
  246.     meldung            : STRING;          (* Meldung, warum keine Primzahl *)
  247.     prim               : BOOLEAN;           (* ist sie Primzahl oder nicht *)
  248. BEGIN
  249.   ClrScr;                                            (* Bildschirm löschen *)
  250.   Frame(27, 1, 53, 3, 1, '', TRUE);                     (* Rahmen ausgeben *)
  251.   WriteXY(29, 2, 'Primzahltest nach Rabin');
  252.   GotoXY(1, 6);
  253.   WriteLn('1. Test: gerade Zahl');                       (* Tests anzeigen *)
  254.   WriteLn('2. Test: Zahl durch 5 dividierbar');
  255.   WriteLn('3. Test: Ziffernsumme durch 3 dividerbar');
  256.   WriteLn('4. Test: RabinTest');
  257.   WriteLn;
  258.   Write('Primzahl (p): '); ReadLn(primzahl);          (* Primzahl eingeben *)
  259.   Write('Fehlerwahrscheinlichkeit: '); ReadLn(wahrscheinlichkeit);
  260.                                       (* Fehlerwahrscheinlichkeit eingeben *)
  261.   anzahl := AnzahlTests(wahrscheinlichkeit);       (* Testanzahl ermitteln *)
  262.   WriteLn;
  263.   WriteLn('Anzahl Tests: ', anzahl);
  264.   WriteLn;
  265.   prim := PrimeTest(primzahl, anzahl, meldung);     (* auf Primzahl testen *)
  266.   Write(primzahl, ' ist ');
  267.   IF NOT prim THEN
  268.     WriteLn('keine Primzahl (',meldung,')')            (* Meldung ausgeben *)
  269.   ELSE
  270.     WriteLn('Primzahl');
  271. END;
  272.  
  273. (* ----------------------------------------------------------------------- *)
  274.  
  275. BEGIN
  276.   Hauptprogramm;                                 (* Hauptprogramm aufrufen *)
  277. END.
  278.  
  279. (* ----------------------------------------------------------------------- *)
  280.  
  281. (* ----------------------------------------------------------------------- *)
  282. (* MyCalc stellt eine LongInteger-Arithmetik zur Verfuegung                *)
  283. (* ----------------------------------------------------------------------- *)
  284.  
  285. {$M 65000, 0, 655360}                          (* Stack auf maximale Groesse *)
  286.  
  287. UNIT MyCalc;
  288.  
  289. INTERFACE
  290.  
  291. CONST MAXCALCSTR = 500;                         (* maximal 500 Word-Zahlen *)
  292.  
  293. TYPE CalcStr = RECORD
  294.                  stellen    : WORD;         (* Anzahl der belegten Stellen *)
  295.                  zahl       : ARRAY[1..MAXCALCSTR] OF WORD;  (* große Zahl *)
  296.                END;
  297.  
  298. PROCEDURE InitCalcStr(VAR calcZahl : CalcStr);
  299. PROCEDURE ReverseCalcStr(VAR ergebnis : CalcStr);
  300. PROCEDURE SwapCalcStr(VAR zahl1, zahl2 : CalcStr);
  301. PROCEDURE PrintCalcStr(VAR calcZahl : CalcStr);
  302. PROCEDURE StrToCalcStr(zeichenkette : STRING; VAR ergebnis : CalcStr);
  303. PROCEDURE WordToCalcStr(zahl : WORD; VAR ergebnis : CalcStr);
  304. PROCEDURE AddCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
  305. PROCEDURE SubCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
  306. PROCEDURE Mul2CalcStr(VAR calcZahl : CalcStr);
  307. PROCEDURE Div2CalcStr(VAR calcZahl : CalcStr);
  308. PROCEDURE MulCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
  309. PROCEDURE ExptCalcStr(VAR basis, exponent: CalcStr; VAR ergebnis : CalcStr);
  310. PROCEDURE RandomCalcStr(VAR calcZahl: CalcStr; VAR ergebnis : CalcStr);
  311. PROCEDURE MulModCalcStr(VAR zahl1, zahl2, modul : CalcStr; VAR ergebnis :
  312. CalcStr);
  313. PROCEDURE ExptModCalcStr(VAR basis, exponent, modul : CalcStr; VAR ergebnis :
  314. CalcStr);
  315.  
  316. FUNCTION CalcStrLength(VAR calcZahl : CalcStr) : WORD;
  317. FUNCTION CalcStrToStr(VAR calcZahl : CalcStr; VAR ergebnis : STRING) : BOOLEAN;
  318. FUNCTION CalcStrToWord(VAR calcZahl : CalcStr; VAR ergebnis : WORD) : BOOLEAN;
  319. FUNCTION EqualCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  320. FUNCTION GreaterCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  321. FUNCTION GreaterEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  322. FUNCTION LessCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  323. FUNCTION LessEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  324. FUNCTION EvenCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
  325. FUNCTION OddCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
  326. FUNCTION DivCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
  327. BOOLEAN;
  328. FUNCTION ModCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
  329. BOOLEAN;
  330.  
  331. IMPLEMENTATION
  332.  
  333. USES Crt;                                         (* Ein/Ausgabefunktionen *)
  334.  
  335. VAR EMPTYCALCSTR : CalcStr;                           (* leerer CalcString *)
  336.     i            : WORD;
  337.                       (* Zählvariable zur Initialisierung von EMPTYCALCSTR *)
  338.  
  339. (* ======================================================================= *)
  340. (* Bitmanipulationen                                                       *)
  341.  
  342. (* ----------------------------------------------------------------------- *)
  343. (* SetBit setzt das BitNr.te Bit in Zahl                                   *)
  344.  
  345. FUNCTION SetBit(zahl : WORD; bitNr : BYTE): WORD;
  346. BEGIN
  347.   SetBit := zahl OR (1 SHL bitNr)
  348.                (* BitNr Stellen nach links shiften und mit oder verknüpfen *)
  349. END;
  350.  
  351. (* ----------------------------------------------------------------------- *)
  352. (* TestBit prüft, ob das BitNr.te Bit in Zahl gesetzt ist                  *)
  353.  
  354. FUNCTION TestBit(zahl : WORD; bitNr: BYTE): BOOLEAN;
  355. BEGIN
  356.   TestBit := (((zahl SHR bitNr) AND 1) = 1)
  357.              (* Bit ist dann gesetzt, falls an der BitNr. Stelle bei einer *)
  358.                               (* Und-Verknüpfung wieder 1 das Ergebnis ist *)
  359. END;
  360.  
  361. (* ======================================================================= *)
  362. (* Hilfsfunktionen für Strings                                             *)
  363.  
  364. (* ----------------------------------------------------------------------- *)
  365. (* TestString prüft, ob im String eine gültige Zahl enthalten ist          *)
  366.  
  367. FUNCTION TestString(zeichenkette : STRING) : BOOLEAN;
  368. VAR laenge : BYTE;                               (* Länge der Zeichenkette *)
  369.     i      : BYTE;                                         (* Zählvariable *)
  370. BEGIN
  371.   laenge := Length(zeichenkette);      (* Länge der Zeichenkette ermitteln *)
  372.   FOR i := 1 TO laenge DO
  373.     IF (NOT (zeichenkette[i] IN ['0'..'9'])) THEN            (* keine Zahl *)
  374.       BEGIN
  375.         TestString := FALSE;                        (* String ist ungültig *)
  376.         EXIT;                                        (* Funktion verlassen *)
  377.       END;
  378.   TestString := TRUE;
  379. END;
  380.  
  381. (* ----------------------------------------------------------------------- *)
  382. (* OddString prüft, ob ein String ungerade ist                             *)
  383.  
  384. FUNCTION OddString(zeichenkette : STRING) : BOOLEAN;
  385. VAR zahl   : BYTE;                          (* Bytedarstellung von Zeichen *)
  386.     dummy  : INTEGER;  (* dient zur Überprüfung von zeichen bei Umwandlung *)
  387.     last   : CHAR;                      (* letztes Zeichen in zeichenkette *)
  388.     laenge : BYTE;                               (* Länge der Zeichenkette *)
  389. BEGIN
  390.   laenge := Length(zeichenkette);        (* Länge muß neu ermittelt werden *)
  391.   last := zeichenkette[laenge];                         (* letztes Zeichen *)
  392.   Val(last, zahl, dummy);             (* letztes Zeichen in zahl umwandeln *)
  393.   oddString := Odd(zahl);                  (* prüfen, ob zahl ungerade ist *)
  394. END;
  395.  
  396. (* ----------------------------------------------------------------------- *)
  397. (* StrDiv2 dividiert einen String durch 2                                  *)
  398.  
  399. FUNCTION StrDiv2(zeichenkette : STRING) : STRING;
  400. VAR hilfe      : STRING;                   (* Hilfsstring für das Ergebnis *)
  401.     index      : BYTE;               (* Index für Position in zeichenkette *)
  402.     laenge     : BYTE;                           (* Länge der Zeichenkette *)
  403.     zahl       : BYTE;                          (* zu dividierender Faktor *)
  404.     zeichen    : CHAR;                      (* Zeichendarstellung von Zahl *)
  405.     dummy      : INTEGER;
  406.                        (* dient zur Überprüfung von zeichen bei Umwandlung *)
  407.     uebertrag  : BOOLEAN;                  (* ist ein Übertrag aufgetreten *)
  408. BEGIN
  409.   hilfe := '';                                     (* hilfe initialisieren *)
  410.   laenge := Length(zeichenkette);                (* Länge der zeichenkette *)
  411.   IF oddString(zeichenkette) THEN           (* falls die Zahl ungerade ist *)
  412.     DEC(zeichenkette[laenge]);                 (* Zahl um 1 dekrementieren *)
  413.   uebertrag := FALSE;                                     (* kein Übertrag *)
  414.   IF zeichenkette[1] = '1' THEN               (* falls an 1.Stelle ein 1er *)
  415.     BEGIN
  416.       index := 2;                              (* an 2.Stelle weitermachen *)
  417.       zahl := 10;                     (* Übertrag an 1.Stelle => zahl = 10 *)
  418.     END
  419.   ELSE
  420.     BEGIN
  421.       index := 1;                                  (* beginne bei 1.Stelle *)
  422.       zahl := 0;                                            (* => zahl = 0 *)
  423.     END;
  424.   REPEAT
  425.     zahl := zahl + Ord(zeichenkette[index]) - 48;        (* Zahl ermitteln *)
  426.     IF (zahl AND 1) = 1 THEN uebertrag := TRUE;
  427.                                               (* ungerade zahl => Übertrag *)
  428.     zahl := zahl SHR 1;                         (* zahl durch 2 dividieren *)
  429.     zeichen := Chr(zahl + 48);   (* Zahl wieder in ASCII-Zeichen umwandeln *)
  430.     hilfe := hilfe + zeichen;                     (* und an hilfe anhängen *)
  431.     INC(index);                                      (* Index um 1 erhöhen *)
  432.     IF uebertrag THEN                                          (* Übertrag *)
  433.       zahl := 10                               (* Übertrag in zahl sichern *)
  434.     ELSE
  435.       zahl := 0;                                         (* sonst zahl = 0 *)
  436.     uebertrag := FALSE;                          (* Annahme: kein Übertrag *)
  437.   UNTIL index > laenge;               (* keine Zeichen mehr zum dividieren *)
  438.   StrDiv2 := hilfe;                             (* Ergebnis steht in Hilfe *)
  439. END;
  440.  
  441. (* ----------------------------------------------------------------------- *)
  442. (* StrMul2 multipliziert einen String mit 2                                *)
  443.  
  444. FUNCTION StrMul2(zeichenkette : STRING) : STRING;
  445. VAR laenge     : BYTE;                          (* Laenge der zeichenkette *)
  446.     i          : BYTE;                                     (* Zählvariable *)
  447.     hilfe      : STRING;                       (* Hilfsstring für Ergebnis *)
  448.     dummyStr   : STRING;           (* dient zur Umwandlung Zahl -> Zeichen *)
  449.     uebertrag  : BOOLEAN;                              (* Übertrag ja/nein *)
  450.     zeichen    : CHAR;                                (* aktuelles Zeichen *)
  451.     zahl       : BYTE;                     (* Byte-Darstellung von zeichen *)
  452.     dummy      : INTEGER;  (* dient zur Prüfung von zeichen bei Umwandlung *)
  453. BEGIN
  454.   laenge := Length(zeichenkette);                       (* Länge ermitteln *)
  455.   uebertrag := FALSE;                            (* Annahme: kein Übertrag *)
  456.   hilfe := '';                               (* Hilfsstring initialisieren *)
  457.   FOR i := laenge DOWNTO 1 DO        (* zeichenkette rückwärts durchlaufen *)
  458.     BEGIN
  459.       zeichen := zeichenkette[i];           (* aktuelles Zeichen ermitteln *)
  460.       zahl := Ord(zeichen) - 48;                 (* in eine Zahl umwandeln *)
  461.       zahl := zahl SHL 1;                     (* Zahl mit 2 multiplizieren *)
  462.       IF uebertrag THEN INC(zahl);              (* bei Übertrag 1 addieren *)
  463.       IF (zahl >= 10) THEN                             (* falls Zahl >= 10 *)
  464.         BEGIN
  465.           uebertrag := TRUE;                       (* Übertrag aufgetreten *)
  466.           zahl := zahl - 10;                      (* Übertrag wegschneiden *)
  467.         END
  468.       ELSE
  469.         uebertrag := FALSE;                         (* sonst kein Übertrag *)
  470.       zeichen := Chr(zahl + 48);              (* zahl in Zeichen umwandeln *)
  471.       hilfe := zeichen + hilfe;                   (* und an Hilfe anhängen *)
  472.     END;
  473.   IF uebertrag THEN hilfe := '1' + hilfe;
  474.                                (* restlichen Übertrag noch berücksichtigen *)
  475.   StrMul2 := hilfe;                                   (* Ergebnis zuweisen *)
  476. END;
  477.  
  478. (* ======================================================================= *)
  479. (* Operationen auf den Datentyp CalcString                                 *)
  480.  
  481. (* ----------------------------------------------------------------------- *)
  482. (* InitCalcStr initialisiert einen CalcString:                             *)
  483.  
  484. PROCEDURE InitCalcStr(VAR calcZahl : CalcStr);
  485. BEGIN
  486.   calcZahl := EMPTYCALCSTR;                     (* leeren CalcStr zuweisen *)
  487. END;
  488.  
  489. (* ----------------------------------------------------------------------- *)
  490. (* CalcStrLength liefert die Länge des CalcStrings zurück                  *)
  491.  
  492. FUNCTION CalcStrLength(VAR calcZahl : CalcStr) : WORD;
  493. BEGIN
  494.   CalcStrLength := calcZahl.stellen;   (* Länge ist in stellen gespeichert *)
  495. END;
  496.  
  497. (* ----------------------------------------------------------------------- *)
  498. (* ReverseCalcStr dreht einen CalcString um                                *)
  499.  
  500. PROCEDURE ReverseCalcStr(VAR ergebnis : CalcStr);
  501. VAR laenge : WORD;                         (* Anzahl Stellen im CalcString *)
  502.     i      : WORD;                                         (* Zählvariable *)
  503.     anzahl : WORD;                                (* benötigte Schrittzahl *)
  504.     hilfe  : WORD;                                     (* Zwischenspeicher *)
  505. BEGIN
  506.   laenge := CalcStrLength(ergebnis);    (* Länge des CalcStrings ermitteln *)
  507.   anzahl := laenge DIV 2;            (* man benötigt nur laenge/2 Schritte *)
  508.   WITH ergebnis DO                                    (* Record abarbeiten *)
  509.     BEGIN
  510.       FOR i := 1 TO anzahl DO
  511.         BEGIN
  512.           hilfe := zahl[i];                              (* i. Zahl merken *)
  513.           zahl[i] := zahl[laenge - (i - 1)];
  514.                         (* i. Zahl wird zur entsprechenden Zahl von hinten *)
  515.           zahl[laenge - (i - 1)] := hilfe;  (* hintere Zahl wird i.te Zahl *)
  516.         END;
  517.     END;
  518. END;
  519.  
  520. (* ----------------------------------------------------------------------- *)
  521. (* SwapCalcStr vertauscht zwei CalcStrings                                 *)
  522.  
  523. PROCEDURE SwapCalcStr(VAR zahl1, zahl2 : CalcStr);
  524. VAR hilfe : CalcStr;                       (* HilfsString für Vertauschung *)
  525. BEGIN
  526.   hilfe := zahl1;                                (* Hilfe auf Zahl1 setzen *)
  527.   zahl1 := zahl2;                                (* Zahl1 auf Zahl2 setzen *)
  528.   zahl2 := hilfe;                                (* Zahl2 auf Hilfe setzen *)
  529. END;
  530.  
  531. (* ----------------------------------------------------------------------- *)
  532. (* PrintCalcStr gibt einen CalcString als Vektor auf dem Bildschirm aus    *)
  533.  
  534. PROCEDURE PrintCalcStr(VAR calcZahl : CalcStr);
  535. VAR i : WORD;                                              (* Zählvariable *)
  536. BEGIN
  537.   ReverseCalcStr(calcZahl);               (* calcZahl muß umgedreht werden *)
  538.   WITH calcZahl DO                              (* Recordtyp als Grundlage *)
  539.     BEGIN
  540.       IF stellen > 0 THEN                        (* Zahl darf nicht 0 sein *)
  541.         BEGIN
  542.           Write('(');                              (* positives Vorzeichen *)
  543.           FOR i := 1 TO (stellen - 1) DO        (* alle Stellen abarbeiten *)
  544.             BEGIN
  545.               Write(zahl[i]);                             (* Zahl ausgeben *)
  546.               Write(',');                       (* durch Beistrich trennen *)
  547.             END;
  548.           Write(zahl[stellen]);                    (* letzte Zahl ausgeben *)
  549.           WriteLn(')');                   (* Klammer des Vektors schließen *)
  550.         END
  551.       ELSE
  552.         WriteLn('(0)');                                (* sonst 0 ausgeben *)
  553.     END;
  554.   ReverseCalcStr(calcZahl);        (* calcZahl muß wieder umgedreht werden *)
  555. END;
  556.  
  557. (* ----------------------------------------------------------------------- *)
  558. (* StrToCalcStr wandelt einen String in einen CalcString um                *)
  559.  
  560. PROCEDURE StrToCalcStr(zeichenkette : STRING; VAR ergebnis : CalcStr);
  561. VAR index  : WORD;                          (* Index im ErgebnisCalcString *)
  562.     bitnr  : BYTE;                        (* Nummer des zu setzenden Bit's *)
  563.     laenge : BYTE;                               (* Länge der Zeichenkette *)
  564. BEGIN
  565.   ergebnis := EMPTYCALCSTR;               (* ErgebnisString initialisieren *)
  566.   index := 1;                              (* erstes Element im CalcString *)
  567.   ergebnis.stellen := 1;       (* Länge des CalcStrings wird auf 1 gesetzt *)
  568.   bitnr := 0;                (* zu Beginn wird Bit 0 gesetzt/nicht gesetzt *)
  569.   laenge := Length(zeichenkette);      (* Länge der Zeichenkette ermitteln *)
  570.   IF TestString(zeichenkette) THEN   (* ist zeichenkette eine gültige Zahl *)
  571.     WITH ergebnis DO                               (* Record als Grundlage *)
  572.       BEGIN
  573.         REPEAT
  574.           IF oddString(zeichenkette) THEN   (* ist zeichenkette ungerade ? *)
  575.             zahl[index] := SetBit(zahl[index], bitnr);       (* Bit setzen *)
  576.           zeichenkette := StrDiv2(zeichenkette);       (* Zeichenkette / 2 *)
  577.           IF zeichenkette <> '0' THEN           (* falls noch nicht fertig *)
  578.             BEGIN
  579.               INC(bitnr);                            (* BitNr um 1 erhöhen *)
  580.               IF bitnr >= 16 THEN                 (* falls 1 Word voll ist *)
  581.                 BEGIN
  582.                   bitnr := 0;                       (* BitNr wird wieder 0 *)
  583.                   INC(index);          (* ein Element im CalcString weiter *)
  584.                   INC(stellen);  (* Länge des CalcStrings wird um 1 erhöht *)
  585.                 END;
  586.             END;
  587.         UNTIL zeichenkette = '0';      (* bis zeichenkette auf 0 reduziert *)
  588.       END;
  589. END;
  590.  
  591. (* ----------------------------------------------------------------------- *)
  592. (* CalcStrToStr wandelt eine CalcString um, falls er sich als String       *)
  593. (* darstellen läßt                                                         *)
  594.  
  595. FUNCTION CalcStrToStr(VAR calcZahl : CalcStr; VAR ergebnis : STRING) : BOOLEAN;
  596. VAR i      : WORD;                                         (* Zählvariable *)
  597.     BitNr  : BYTE;                            (* Nummer des aktuellen Bits *)
  598.     anzahl : WORD;                         (* Anzahl Stellen im CalcString *)
  599.     laenge : BYTE;                            (* Länge des Ergebnisstrings *)
  600. BEGIN
  601.   IF calcZahl.Stellen > 50 THEN         (* Stringlänge würde überschritten *)
  602.     CalcStrToStr := FALSE                                (* Stringüberlauf *)
  603.   ELSE
  604.     BEGIN                                     (* Zahl paßt in einen String *)
  605.       ergebnis := '0';                   (* Ergebnisstring ist zu Beginn 0 *)
  606.       anzahl := CalcStrLength(calcZahl);          (* Länge des CalcStrings *)
  607.       FOR i := anzahl DOWNTO 1 DO
  608.                                (* alle Element des CalcStrings durchlaufen *)
  609.         FOR BitNr := 15 DOWNTO 0 DO                    (* alle Bits prüfen *)
  610.           BEGIN
  611.             ergebnis := StrMul2(ergebnis);   (* ErgebnisString mit 2 mult. *)
  612.             IF TestBit(calcZahl.zahl[i], BitNr) THEN
  613.                                                   (* Ist das Bit gesetzt ? *)
  614.               BEGIN
  615.                 laenge := Length(ergebnis);             (* Länge ermitteln *)
  616.                 INC(ergebnis[laenge]);     (* letztes Zeichen um 1 erhöhen *)
  617.               END;
  618.           END;
  619.       CalcStrToStr := TRUE;                         (* Umwandlung geglückt *)
  620.     END;
  621. END;
  622.  
  623. (* ----------------------------------------------------------------------- *)
  624. (* WordToCalcStr wandelt eine Wordzahl in einen CalcString um              *)
  625.  
  626. PROCEDURE WordToCalcStr(zahl : WORD; VAR ergebnis : CalcStr);
  627. BEGIN
  628.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  629.   ergebnis.stellen := 1;                           (* 1 Stelle wird belegt *)
  630.   ergebnis.zahl[1] := zahl;                    (* Zahl in CalcZahl sichern *)
  631. END;
  632.  
  633. (* ----------------------------------------------------------------------- *)
  634. (* CalcStrToWord wandelt einen CalcString in eine Wordzahl um              *)
  635.  
  636. FUNCTION CalcStrToWord(VAR calcZahl : CalcStr; VAR ergebnis : WORD) : BOOLEAN;
  637. BEGIN
  638.   IF (calcZahl.Stellen > 1) THEN
  639.             (* Zahl mit mehr als 1 Stelle können nicht  umgewandelt werden *)
  640.     CalcStrToWord := FALSE                             (* keine Umwandlung *)
  641.   ELSE
  642.     BEGIN
  643.       ergebnis := calcZahl.zahl[1];                (* Ergebnis zurückgeben *)
  644.       CalcStrToWord := TRUE;                        (* Umwandlung geglückt *)
  645.     END;
  646. END;
  647.  
  648. (* ----------------------------------------------------------------------- *)
  649. (* EqualCalcStr prüft, ob ein CalcStr1 = CalcStr2                          *)
  650.  
  651. FUNCTION EqualCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  652. VAR i : WORD;                                              (* Zählvariable *)
  653. BEGIN
  654.   IF (zahl1.stellen <> zahl2.stellen) THEN
  655.     EqualCalcStr := FALSE               (* unterschiedliche Anzahl Stellen *)
  656.   ELSE                                               (* Stellenzahl gleich *)
  657.     BEGIN
  658.       FOR i := 1 TO zahl1.stellen DO            (* alle Stellen abarbeiten *)
  659.         IF zahl1.zahl[i] <> zahl2.zahl[i] THEN       (* Zahlen verschieden *)
  660.           BEGIN
  661.             EqualCalcStr := FALSE;              (* Zahlen sind verschieden *)
  662.             EXIT;                                    (* Schleife verlassen *)
  663.           END;
  664.       EqualCalcStr := TRUE;                          (* Zahlen sind gleich *)
  665.     END;
  666. END;
  667.  
  668. (* ----------------------------------------------------------------------- *)
  669. (* GreaterCalcStr prüft, ob ein CalcStr1 > CalcStr2                        *)
  670.  
  671. FUNCTION GreaterCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  672. VAR i     : WORD;                                          (* Zählvariable *)
  673.     hilfe : BOOLEAN;                                      (* Hilfsvariable *)
  674. BEGIN
  675.   IF (zahl1.stellen > zahl2.stellen) THEN    (* Zahl1 besitzt mehr Stellen *)
  676.     GreaterCalcStr := TRUE                             (* => Zahl1 > Zahl2 *)
  677.   ELSE
  678.     IF (zahl1.stellen < zahl2.stellen) THEN
  679.                                           (* Zahl1 besitzt weniger Stellen *)
  680.       GreaterCalcStr := FALSE                    (* => Zahl1 nicht > Zahl2 *)
  681.     ELSE                                             (* Stellenzahl gleich *)
  682.       BEGIN
  683.         FOR i := zahl1.stellen DOWNTO 1 DO      (* alle Stellen abarbeiten *)
  684.           IF zahl1.zahl[i] > zahl2.zahl[i] THEN
  685.                              (* i.Stelle von Zahl1 > i.te Stelle von Zahl2 *)
  686.             BEGIN
  687.               GreaterCalcStr := TRUE;                     (* Zahl1 > Zahl2 *)
  688.               EXIT;                                  (* Schleife verlassen *)
  689.             END
  690.           ELSE
  691.             IF zahl1.zahl[i] < zahl2.zahl[i] THEN
  692.                              (* i.Stelle von Zahl1 < i.te Stelle von Zahl2 *)
  693.               BEGIN
  694.                 GreaterCalcStr := FALSE;            (* Zahl1 nicht > Zahl2 *)
  695.                 EXIT;                                (* Schleife verlassen *)
  696.               END;
  697.         GreaterCalcStr := FALSE;               (* alle Stellen sind gleich *)
  698.       END;
  699. END;
  700.  
  701. (* ----------------------------------------------------------------------- *)
  702. (* GreaterEqual prüft, ob Zahl1 >= Zahl2                                   *)
  703.  
  704. FUNCTION GreaterEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  705. BEGIN
  706.   GreaterEqual := NOT LessCalcStr(zahl1, zahl2);
  707.                  (* Zahl1 >= Zahl2, wenn Zahl1 nicht kleiner als Zahl2 ist *)
  708. END;
  709.  
  710. (* ----------------------------------------------------------------------- *)
  711. (* LessCalcStr prüft, on Zahl1 < Zahl2                                     *)
  712.  
  713. FUNCTION LessCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  714. VAR i     : WORD;                                          (* Zählvariable *)
  715.     hilfe : BOOLEAN;                                      (* Hilfsvariable *)
  716. BEGIN
  717.   IF (zahl1.stellen < zahl2.stellen) THEN (* Zahl1 besitzt weniger Stellen *)
  718.     LessCalcStr := TRUE                                (* => Zahl1 < Zahl2 *)
  719.   ELSE
  720.     IF (zahl1.stellen > zahl2.stellen) THEN  (* Zahl1 besitzt mehr Stellen *)
  721.       LessCalcStr := FALSE                       (* => Zahl1 nicht < Zahl2 *)
  722.     ELSE                                             (* Stellenzahl gleich *)
  723.       BEGIN
  724.         FOR i := zahl1.stellen DOWNTO 1 DO      (* alle Stellen abarbeiten *)
  725.           IF zahl1.zahl[i] < zahl2.zahl[i] THEN
  726.                              (* i.Stelle von Zahl1 < i.te Stelle von Zahl2 *)
  727.             BEGIN
  728.               LessCalcStr := TRUE;                        (* Zahl1 < Zahl2 *)
  729.               EXIT;                                  (* Schleife verlassen *)
  730.             END
  731.           ELSE
  732.             IF zahl1.zahl[i] > zahl2.zahl[i] THEN
  733.                              (* i.Stelle von Zahl1 > i.te Stelle von Zahl2 *)
  734.               BEGIN
  735.                 LessCalcStr := FALSE;               (* Zahl1 nicht < Zahl2 *)
  736.                 EXIT;                                (* Schleife verlassen *)
  737.               END;
  738.         LessCalcStr := FALSE;                  (* alle Stellen sind gleich *)
  739.       END;
  740. END;
  741.  
  742. (* ----------------------------------------------------------------------- *)
  743. (* LessEqual prüft, ob Zahl1 <= Zahl2                                      *)
  744.  
  745. FUNCTION LessEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
  746. BEGIN
  747.   LessEqual := NOT GreaterCalcStr(zahl1, zahl2);
  748.                   (* Zahl1 <= Zahl2, wenn Zahl1 nicht größer als Zahl2 ist *)
  749. END;
  750.  
  751. (* ----------------------------------------------------------------------- *)
  752. (* EvenCalcStr prüft, ob ein CalcString gerade ist                         *)
  753.  
  754. FUNCTION EvenCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
  755. BEGIN
  756.   EvenCalcStr := NOT Odd(calcZahl.zahl[1]);
  757.         (* CalcZahl ist gerade, falls die letzte Stelle nicht ungerade ist *)
  758. END;
  759.  
  760. (* ----------------------------------------------------------------------- *)
  761. (* OddCalcStr prüft, ob ein CalcString ungerade ist                        *)
  762.  
  763. FUNCTION OddCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
  764. BEGIN
  765.   OddCalcStr := Odd(calcZahl.zahl[1]);
  766.             (* CalcZahl ist ungerade, falls die letzte Stelle ungerade ist *)
  767. END;
  768.  
  769. (* ----------------------------------------------------------------------- *)
  770. (* AddCalcStr addiert zwei CalcStrings                                     *)
  771.  
  772. PROCEDURE AddCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
  773. VAR anzahl    : WORD;                       (* Anzahl Stellen für Addition *)
  774.     i         : WORD;                                      (* Zählvariable *)
  775.     summe     : LongInt;      (* Hilfsvariable zur Prüfung eines Übertrags *)
  776.     ueberlauf : BYTE;                   (* Überlauf = 1, kein Überlauf = 0 *)
  777.     addition  : BOOLEAN;        (* können Zahlen addiert werden oder nicht *)
  778. BEGIN
  779.   {$Q-}                                     (* Überlaufprüfung ausschalten *)
  780.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  781.   anzahl := zahl1.stellen;                   (* Annahme: Zahl 1 ist größer *)
  782.   IF zahl2.stellen > anzahl THEN          (* Falls doch 2. Zahl größer ist *)
  783.     anzahl := zahl2.stellen;     (* so viele Stellen müssen addiert werden *)
  784.   ueberlauf := 0;                               (* zu Beginn kein Überlauf *)
  785.   FOR i := 1 TO anzahl DO                     (* anzahl Stellen abarbeiten *)
  786.     BEGIN
  787.       ergebnis.zahl[i] := zahl1.zahl[i] + zahl2.zahl[i] + ueberlauf;
  788.                  (* ergebnis ist die Summe der beiden Zahlen (kann einfach *)
  789.                  (* addiert werden, weil Überlaufprüfung ausgeschaltet ist *)
  790.       summe := LongInt(zahl1.zahl[i]) + LongInt(zahl2.zahl[i]) + ueberlauf;
  791.                                                     (* Summe ohne Überlauf *)
  792.       IF (summe > ergebnis.zahl[i]) THEN   (* ist ein Überlauf aufgetreten *)
  793.         ueberlauf := 1                      (* ja -> Überlauf auf 1 setzen *)
  794.       ELSE
  795.         ueberlauf := 0;                          (* nein -> Überlauf ist 0 *)
  796.     END;
  797.   IF (ueberlauf = 1) THEN           (* letzter Überlauf muß geprüft werden *)
  798.     BEGIN
  799.       ergebnis.stellen := anzahl + 1;    (* letzter Überlauf belegt 1 Feld *)
  800.       ergebnis.zahl[anzahl + 1] := 1;      (* Zahl 1 steht im letzten Feld *)
  801.     END
  802.   ELSE
  803.     ergebnis.stellen := anzahl;
  804.                               (* gleich viele Stellen wie die längere Zahl *)
  805.   {$Q+}                              (* Überlaufprüfung wieder einschalten *)
  806. END;
  807.  
  808. (* ----------------------------------------------------------------------- *)
  809. (* SubCalcStr subtrahiert zahl2 von zahl1                                  *)
  810.  
  811. PROCEDURE SubCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
  812. VAR swapped   : BOOLEAN;            (* wurden Zahl1 und Zahl2 vertauscht ? *)
  813.     i         : WORD;                                      (* Zählvariable *)
  814.     uebertrag : BYTE;                     (* Übertrag: 1, kein Übertrag: 0 *)
  815. BEGIN
  816.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  817.   swapped := FALSE;                      (* Zahlen wurden nicht vertauscht *)
  818.   uebertrag := 0;                                         (* kein Übertrag *)
  819.   IF GreaterCalcStr(zahl2, zahl1) THEN EXIT;              (* Zahl2 > Zahl1 *)
  820.   FOR i := 1 TO zahl1.stellen DO                (* alle Stellen abarbeiten *)
  821.     BEGIN
  822.       IF (zahl1.zahl[i] >= (zahl2.zahl[i] + uebertrag)) THEN
  823.                 (* Zahl1[i] >= Zahl2[i] mit Berücksichtigung des Übertrags *)
  824.         BEGIN
  825.           ergebnis.zahl[i] := zahl1.zahl[i] - (zahl2.zahl[i] + uebertrag);
  826.                                          (* Differenz der Zahlen ermitteln *)
  827.           uebertrag := 0;                                 (* kein Übertrag *)
  828.         END
  829.       ELSE
  830.         BEGIN
  831.           ergebnis.zahl[i] := LongInt(zahl1.zahl[i] + 65536) - (zahl2.zahl[i] +
  832. uebertrag);
  833.           uebertrag := 1;
  834.         END;
  835.      END;
  836.   ergebnis.stellen := zahl1.stellen;
  837.                                  (* Annahme: gleich viel Stellen wie Zahl1 *)
  838.   WHILE (ergebnis.zahl[ergebnis.stellen] = 0) AND (ergebnis.stellen > 0) DO
  839.     DEC(ergebnis.stellen);               (* richtige Stellenzahl ermitteln *)
  840. END;
  841.  
  842. (* ----------------------------------------------------------------------- *)
  843. (* Mul2CalcStr multipliziert einen CalcString mit 2                        *)
  844.  
  845. PROCEDURE Mul2CalcStr(VAR calcZahl : CalcStr);
  846. VAR i : WORD;                                              (* Zählvariable *)
  847. BEGIN
  848.   WITH calcZahl DO                                 (* Record als Grundlage *)
  849.     IF ((stellen = 1) AND (zahl[1] = 0)) OR (stellen = 0) THEN
  850.     ELSE                               (* CalcZahl ist 0 => Ergebnis ist 0 *)
  851.       BEGIN                                     (* Sonst ist Ergebnis <> 0 *)
  852.         IF (zahl[stellen] AND 32768) > 0 THEN
  853.           BEGIN                 (* Ist 16.Bit der letzten Stelle gesetzt ? *)
  854.             INC(stellen);                      (* Stellenzahl um 1 erhöhen *)
  855.             zahl[stellen] := 0;                (* und mit 0 initialisieren *)
  856.           END;
  857.         FOR i := (stellen - 1) DOWNTO 1 DO              (* Zahl abarbeiten *)
  858.           BEGIN
  859.             zahl[i + 1] := zahl[i + 1] SHL 1;           (* Zahl[i + 1] * 2 *)
  860.             IF (zahl[i] AND 32768) > 0 THEN INC(zahl[i + 1]);
  861.           END;          (* Bei Überlauf bei Zahl[i] => Zahl[i + 1] erhöhen *)
  862.         zahl[1] := zahl[1] SHL 1;          (* 1. Zahl mit 2 multiplizieren *)
  863.       END;
  864. END;
  865.  
  866. (* ----------------------------------------------------------------------- *)
  867. (* Div2CalcStr dividiert einen CalcString durch 2                          *)
  868.  
  869. PROCEDURE Div2CalcStr(VAR calcZahl : CalcStr);
  870. VAR i : WORD;                                              (* Zählvariable *)
  871. BEGIN
  872.   WITH calcZahl DO
  873.     IF ((stellen = 1) AND (zahl[1] = 0)) OR (stellen = 0) THEN
  874.     ELSE                               (* calcZahl = 0 => calcZahl * 2 = 0 *)
  875.       BEGIN
  876.         FOR i := 1 TO (stellen - 1) DO                  (* Zahl abarbeiten *)
  877.           BEGIN
  878.             zahl[i] := zahl[i] SHR 1;                     (* Zahl[i] DIV 2 *)
  879.             IF (zahl[i + 1] AND 1) > 0 THEN
  880.                            (* Falls bei Zahl[i + 1] ein Unterlauf auftritt *)
  881.               zahl[i] := zahl[i] OR 32768;    (* Bit 16 bei Zahl[i] setzen *)
  882.           END;
  883.         zahl[stellen] := zahl[stellen] SHR 1;       (* letzte Stelle DIV 2 *)
  884.         IF (zahl[stellen] = 0) THEN DEC(stellen);
  885.                   (* Falls letzte Stelle 0 ist => Stellen um 1 erniedrigen *)
  886.       END;
  887. END;
  888.  
  889. (* ----------------------------------------------------------------------- *)
  890. (* MulCalcStr multiplizier2 zahl1 mit zahl2                                *)
  891.  
  892. PROCEDURE MulCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
  893. VAR hilfe       : CalcStr;                              (* HilfsCalcString *)
  894.     hilfe1      : CalcStr;                              (* HilfsCalcString *)
  895.     hilfe2      : CalcStr;                              (* HilfsCalcString *)
  896.     i, j        : WORD;                                   (* Zählvariablen *)
  897.     wert        : WORD;               (* Wert von Zahl an der i.ten Stelle *)
  898. BEGIN
  899.   IF LessCalcStr(zahl1, zahl2) THEN                 (* Falls zahl1 < zahl2 *)
  900.     BEGIN
  901.       hilfe1 := zahl1;                     (* Hilfe1 wird Zahl1 zugewiesen *)
  902.       hilfe2 := zahl2;                     (* Hilfe2 wird Zahl2 zugewiesen *)
  903.     END
  904.   ELSE
  905.     BEGIN
  906.       hilfe2 := zahl1;                     (* Hilfe2 wird Zahl1 zugewiesen *)
  907.       hilfe1 := zahl2;                     (* Hilfe1 wird Zahl2 zugewiesen *)
  908.     END;
  909.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  910.   IF ((hilfe1.stellen = 1) AND (hilfe1.zahl[1] = 0)) OR (hilfe1.stellen = 0)
  911. THEN
  912.   ELSE                                       (* Ergebnis=0, weil X * 0 = 0 *)
  913.     BEGIN
  914.       i := 1;                                    (* i mit 1 initialisieren *)
  915.       WHILE (i <= (hilfe1.stellen - 1)) DO           (* Hilfe 1 abarbeiten *)
  916.         BEGIN
  917.           wert := hilfe1.zahl[i];                         (* Wert = i.Zahl *)
  918.           j := 1;                                (* j mit 1 initialisieren *)
  919.           WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
  920.             BEGIN
  921.               IF (wert AND 1) > 0 THEN              (* Falls 1.Bit gesetzt *)
  922.                 BEGIN
  923.                   AddCalcStr(ergebnis, hilfe2, hilfe);
  924.                                            (* Ergebnis und Hilfe2 addieren *)
  925.                   ergebnis := hilfe;              (* Ergebnis aus Addition *)
  926.                 END;
  927.               wert := wert SHR 1;                            (* Wert DIV 2 *)
  928.               Mul2CalcStr(hilfe2);                           (* Hilfe2 * 2 *)
  929.               INC(j);                                    (* j um 1 erhöhen *)
  930.             END;
  931.           INC(i);                                        (* i um 1 erhöhen *)
  932.         END;
  933.       wert := hilfe1.zahl[hilfe1.stellen];      (* letzte Stelle behandeln *)
  934.       WHILE wert > 0 DO                  (* Solange noch 1 Bit gesetzt ist *)
  935.         BEGIN
  936.           IF (wert AND 1) > 0 THEN              (* Falls Bit 1 gesetzt ist *)
  937.             BEGIN
  938.               AddCalcStr(ergebnis, hilfe2, hilfe);
  939.                                            (* Ergebnis und Hilfe2 addieren *)
  940.               ergebnis := hilfe;                  (* Ergebnis aus Addition *)
  941.             END;
  942.           wert := wert SHR 1;                                (* Wert DIV 2 *)
  943.           Mul2CalcStr(hilfe2);                               (* Hilfe2 * 2 *)
  944.         END;
  945.     END;
  946. END;
  947.  
  948. (* ----------------------------------------------------------------------- *)
  949. (* DivCalcStr dividiert einen CalcString durch einen anderen               *)
  950.  
  951. FUNCTION DivCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
  952. BOOLEAN;
  953. VAR hilfe       : CalcStr;                              (* HilfsCalcString *)
  954.  
  955.     hilfe1      : CalcStr;                              (* HilfsCalcString *)
  956.     hilfe2      : CalcStr;                              (* HilfsCalcString *)
  957.     EINS        : CalcStr;                 (* konstanter HilfsString für 1 *)
  958. BEGIN
  959.   IF ((zahl2.stellen = 1) AND (zahl2.zahl[1] = 0)) OR (zahl2.stellen = 0) THEN
  960.     DivCalcStr := FALSE                  (* Division durch 0 nicht möglich *)
  961.   ELSE
  962.     BEGIN
  963.       EINS := EMPTYCALCSTR;                         (* Eins initialisieren *)
  964.       EINS.stellen := 1;                          (* Eins besitzt 1 Stelle *)
  965.       EINS.zahl[1] := 1;                        (* diese wird mit 1 belegt *)
  966.       ergebnis := EMPTYCALCSTR;                 (* Ergebnis initialisieren *)
  967.       hilfe1 := zahl1;                     (* Hilfe1 wird Zahl1 zugewiesen *)
  968.       hilfe2 := zahl2;                     (* Hilfe2 wird Zahl2 zugewiesen *)
  969.       WHILE NOT (GreaterCalcStr(hilfe2, hilfe1)) DO
  970.         Mul2CalcStr(hilfe2);
  971.            (* schiebe hilfe2 solange nach links, bis dividiert werden kann *)
  972.       WHILE NOT (EqualCalcStr(hilfe2, zahl2)) DO       (* Abbruchbedingung *)
  973.         BEGIN
  974.           Mul2CalcStr(ergebnis);          (* Ergebnis mit 2 multiplizieren *)
  975.           Div2CalcStr(hilfe2);                (* Hilfe2 durch 2 dividieren *)
  976.           IF NOT (GreaterCalcStr(hilfe2, hilfe1)) THEN
  977.                                             (* falls hilfe2 nicht > hilfe1 *)
  978.             BEGIN
  979.               SubCalcStr(hilfe1, hilfe2, hilfe);        (* Hilfe1 - Hilfe2 *)
  980.               hilfe1 := hilfe;             (* Hilfe1 wird Hilfe zugewiesen *)
  981.               AddCalcStr(ergebnis, EINS, hilfe);(* zum Ergebnis 1 addieren *)
  982.               ergebnis := hilfe;         (* Ergebnis wird hilfe zugewiesen *)
  983.             END;
  984.         END;
  985.       DivCalcStr := TRUE;                          (* Division erfolgreich *)
  986.     END;
  987. END;
  988.  
  989. (* ----------------------------------------------------------------------- *)
  990. (* ModCalcStr berechnet den Rest bei Division von Zahl1 durch Zahl2        *)
  991.  
  992. FUNCTION ModCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
  993. BOOLEAN;
  994. VAR hilfe       : CalcStr;                              (* HilfsCalcString *)
  995.     hilfe1      : CalcStr;                              (* HilfsCalcString *)
  996.     hilfe2      : CalcStr;                              (* HilfsCalcString *)
  997.     EINS        : CalcStr;                 (* konstanter HilfsString für 1 *)
  998. BEGIN
  999.   IF ((zahl2.stellen = 1) AND (zahl2.zahl[1] = 0)) OR (zahl2.stellen = 0) THEN
  1000.     ModCalcStr := FALSE                  (* Division durch 0 nicht möglich *)
  1001.   ELSE
  1002.     BEGIN
  1003.       EINS := EMPTYCALCSTR;                         (* Eins initialisieren *)
  1004.       EINS.stellen := 1;                          (* Eins besitzt 1 Stelle *)
  1005.       EINS.zahl[1] := 1;                        (* diese wird mit 1 belegt *)
  1006.       ergebnis := EMPTYCALCSTR;                 (* Ergebnis initialisieren *)
  1007.       IF GreaterCalcStr(zahl2, zahl1) THEN          (* falls Zahl2 > Zahl1 *)
  1008.         ergebnis := zahl1                            (* Ergebnis ist Zahl1 *)
  1009.       ELSE
  1010.         BEGIN
  1011.           hilfe1 := zahl1;                 (* Hilfe1 wird Zahl1 zugewiesen *)
  1012.           hilfe2 := zahl2;                 (* Hilfe2 wird Zahl2 zugewiesen *)
  1013.           WHILE NOT (GreaterCalcStr(hilfe2, hilfe1)) DO
  1014.             Mul2CalcStr(hilfe2);
  1015.            (* schiebe hilfe2 solange nach links, bis dividiert werden kann *)
  1016.           WHILE NOT (EqualCalcStr(hilfe2, zahl2)) DO   (* Abbruchbedingung *)
  1017.             BEGIN
  1018.               Mul2CalcStr(ergebnis);      (* Ergebnis mit 2 multiplizieren *)
  1019.               Div2CalcStr(hilfe2);            (* Hilfe2 durch 2 dividieren *)
  1020.               IF NOT (GreaterCalcStr(hilfe2, hilfe1)) THEN
  1021.                                             (* falls hilfe2 nicht > hilfe1 *)
  1022.                 BEGIN
  1023.                   SubCalcStr(hilfe1, hilfe2, hilfe);    (* Hilfe1 - Hilfe2 *)
  1024.                   hilfe1 := hilfe;         (* Hilfe1 wird Hilfe zugewiesen *)
  1025.                   AddCalcStr(ergebnis, EINS, hilfe);
  1026.                                                 (* zum Ergebnis 1 addieren *)
  1027.                   ergebnis := hilfe;     (* Ergebnis wird hilfe zugewiesen *)
  1028.                 END;
  1029.             END;
  1030.           ModCalcStr := TRUE;                      (* Division erfolgreich *)
  1031.         END;
  1032.     END;
  1033. END;
  1034.  
  1035. (* ----------------------------------------------------------------------- *)
  1036. (* ExptCalcStr berechnet Basis^Exponent                                    *)
  1037.  
  1038. PROCEDURE ExptCalcStr(VAR basis, exponent: CalcStr; VAR ergebnis : CalcStr);
  1039. VAR hilfe  : CalcStr;                                   (* HilfsCalcString *)
  1040.     hilfe1 : CalcStr;                                   (* HilfsCalcString *)
  1041.     i, j   : WORD;                                        (* Zählvariablen *)
  1042.     wert   : WORD;              (* Wert des Exponenten an der i.ten Stelle *)
  1043. BEGIN
  1044.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  1045.   ergebnis.stellen := 1;                     (* Ergebnis hat min. 1 Stelle *)
  1046.   ergebnis.zahl[1] := 1;                                  (* Ergebnis >= 1 *)
  1047.   IF ((exponent.stellen = 1) AND (exponent.zahl[1] = 0)) OR (exponent.stellen =
  1048. 0) THEN
  1049.   ELSE                                     (* Exponent = 0 => Ergebnis = 1 *)
  1050.     BEGIN
  1051.       hilfe1 := basis;                     (* Hilfe1 wird Basis zugewiesen *)
  1052.       i := 1;                                (* i wird mit 1 initialisiert *)
  1053.       WHILE (i <= (exponent.stellen - 1)) DO      (* Exponenten abarbeiten *)
  1054.         BEGIN
  1055.           wert := exponent.zahl[i];          (* i.te Stelle des Exponenten *)
  1056.           INC(i);                                        (* i um 1 erhöhen *)
  1057.           j := 1;                            (* j wird mit 1 initialisiert *)
  1058.           WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
  1059.             BEGIN
  1060.               IF (wert AND 1) = 1 THEN         (* falls 1. Bit gesetzt ist *)
  1061.                 MulCalcStr(ergebnis, hilfe1, ergebnis);
  1062.                                      (* Ergebnis mit Hilfe1 multiplizieren *)
  1063.               MulCalcStr(hilfe1, hilfe1, hilfe1);     (* Hilfe1 quadrieren *)
  1064.               wert := wert SHR 1;                            (* Wert DIV 2 *)
  1065.               INC(j);                                 (* 1 Bit weitergehen *)
  1066.             END;
  1067.         END;
  1068.       wert := exponent.zahl[exponent.stellen];  (* letzte Stelle behandeln *)
  1069.       WHILE (wert <> 0) DO                   (* solange noch 1 Bit gesetzt *)
  1070.         BEGIN
  1071.           IF (wert AND 1) = 1 THEN             (* falls 1. Bit gesetzt ist *)
  1072.             MulCalcStr(ergebnis, hilfe1, ergebnis);
  1073.                                      (* Ergebnis mit Hilfe1 multiplizieren *)
  1074.           MulCalcStr(hilfe1, hilfe1, hilfe1);         (* Hilfe1 quadrieren *)
  1075.           wert := wert SHR 1;                                (* Wert DIV 2 *)
  1076.         END;
  1077.     END;
  1078. END;
  1079.  
  1080. (* ----------------------------------------------------------------------- *)
  1081. (* RandomCalcStr liefert eine Zufallszahl < calcZahl                       *)
  1082.  
  1083. PROCEDURE RandomCalcStr(VAR calcZahl: CalcStr; VAR ergebnis : CalcStr);
  1084. VAR i : WORD;                                              (* Zählvariable *)
  1085. BEGIN
  1086.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  1087.   ergebnis.stellen := calcZahl.stellen; (* Annahme: Stellenzahl ist gleich *)
  1088.   FOR i := 1 TO (calcZahl.stellen - 1) DO
  1089.     ergebnis.zahl[i] := Random(65535);           (* zufällige Zahl < 65535 *)
  1090.   ergebnis.zahl[ergebnis.stellen] := Random(calcZahl.zahl[calcZahl.stellen]);
  1091.                               (* letzte Zahl muß kleiner Ausgangszahl sein *)
  1092.   WHILE (ergebnis.zahl[ergebnis.stellen] = 0) AND (ergebnis.stellen > 1) DO
  1093.     DEC(ergebnis.stellen);                  (* führende Nullen abschneiden *)
  1094.   IF ((ergebnis.stellen = 1) AND (ergebnis.zahl[1] = 0)) OR (ergebnis.stellen =
  1095. 0) THEN
  1096.     BEGIN                                    (* Ergebnis darf nicht 0 sein *)
  1097.       ergebnis.stellen := 1;                              (* min. 1 Stelle *)
  1098.       ergebnis.zahl[1] := 1;                       (* diese mit 1 besetzen *)
  1099.     END;
  1100. END;
  1101.  
  1102. (* ----------------------------------------------------------------------- *)
  1103. (* MulModCalcStr multipliziert ein Zahl modulo modul                       *)
  1104.  
  1105. PROCEDURE MulModCalcStr(VAR zahl1, zahl2, modul : CalcStr; VAR ergebnis :
  1106. CalcStr);
  1107. VAR i, j   : WORD;                                        (* Zählvariablen *)
  1108.     wert   : WORD;                        (* Wert von Zahl an i.ter Stelle *)
  1109.     hilfe  : CalcStr;                                   (* HilfsCalcString *)
  1110.     hilfe1 : CalcStr;                                   (* HilfsCalcString *)
  1111.     hilfe2 : CalcStr;                                   (* HilfsCalcString *)
  1112. BEGIN
  1113.   IF LessCalcStr(zahl1, zahl2) THEN                 (* Falls Zahl1 < Zahl2 *)
  1114.     BEGIN
  1115.       ModCalcStr(zahl1, modul, hilfe1);       (* Divisionsrest Zahl1/Modul *)
  1116.       ModCalcStr(zahl2, modul, hilfe2);       (* Divisionsrest Zahl2/Modul *)
  1117.     END
  1118.   ELSE
  1119.     BEGIN
  1120.       ModCalcStr(zahl1, modul, hilfe2);       (* Divisionsrest Zahl1/Modul *)
  1121.       ModCalcStr(zahl2, modul, hilfe1);       (* Divisionsrest Zahl2/Modul *)
  1122.     END;
  1123.   ergebnis := EMPTYCALCSTR;           (* ErgebnisCalcString initialisieren *)
  1124.   IF ((hilfe1.stellen = 1) AND (hilfe1.zahl[1] = 0)) OR (hilfe1.stellen = 0)
  1125. THEN
  1126.                                              (* Hilfe1 muß ungleich 0 sein *)
  1127.   ELSE
  1128.     BEGIN
  1129.       i := 1;                                    (* i mit 1 initialisieren *)
  1130.       WHILE (i <= (hilfe1.stellen - 1)) DO
  1131.                                      (* alle Stellen von Hilfe1 abarbeiten *)
  1132.         BEGIN
  1133.           wert := hilfe1.zahl[i];              (* aktuellen Wert ermitteln *)
  1134.           j := 1;                                (* j mit 1 initialisieren *)
  1135.           WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
  1136.             BEGIN
  1137.               IF (wert AND 1) > 0 THEN          (* Falls Bit 1 gesetzt ist *)
  1138.                 BEGIN
  1139.                   AddCalcStr(ergebnis, hilfe2, hilfe);
  1140.                                            (* Hilfe2 zum Ergebnis addieren *)
  1141.                   ergebnis := hilfe;          (* und dem Ergebnis zuweisen *)
  1142.                 END;
  1143.               wert := wert SHR 1;               (* Wert durch 2 dividieren *)
  1144.               Mul2CalcStr(hilfe2);          (* Hilfe2 mit 2 multiplizieren *)
  1145.               INC(j);                                    (* j um 1 erhöhen *)
  1146.             END;
  1147.           INC(i);                                        (* i um 1 erhöhen *)
  1148.         END;
  1149.       wert := hilfe1.zahl[hilfe1.stellen];
  1150.                                         (* letzte Zahl gesondert behandeln *)
  1151.       WHILE (wert > 0) DO                  (* solange noch ein Bit gesetzt *)
  1152.         BEGIN
  1153.           IF (wert AND 1) > 0 THEN             (* Falls 1. Bit gesetzt ist *)
  1154.             BEGIN
  1155.               AddCalcStr(ergebnis, hilfe2, hilfe);
  1156.                                            (* Hilfe2 zum Ergebnis addieren *)
  1157.               ergebnis := hilfe;              (* und dem Ergebnis zuweisen *)
  1158.             END;
  1159.           wert := wert SHR 1;                   (* Wert durch 2 dividieren *)
  1160.           Mul2CalcStr(hilfe2);              (* Hilfe2 mit 2 multiplizieren *)
  1161.         END;
  1162.     END;
  1163.   hilfe1 := ergebnis;                   (* Hilfe1 wird Ergebnis zugewiesen *)
  1164.   ModCalcStr(hilfe1, modul, ergebnis);       (* Divisionsrest hilfe1/Modul *)
  1165. END;
  1166.  
  1167. (* ----------------------------------------------------------------------- *)
  1168. (* ExptModCalcStr berechnet basis^exponent MOD modul                       *)
  1169.  
  1170. PROCEDURE ExptModCalcStr(VAR basis, exponent, modul : CalcStr; VAR ergebnis :
  1171. CalcStr);
  1172. VAR i, j   : WORD;                                        (* Zählvariablen *)
  1173.     wert   : WORD;                        (* Wert von Zahl an i.ter Stelle *)
  1174.     hilfe  : CalcStr;                                   (* HilfsCalcString *)
  1175.     hilfe1 : CalcStr;                                   (* HilfsCalcString *)
  1176. BEGIN
  1177.   ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  1178.   ergebnis.stellen := 1;                 (* Ergebnis besitzt min. 1 Stelle *)
  1179.   ergebnis.zahl[1] := 1;                      (* Ergebnis hat mind. Wert 1 *)
  1180.   IF ((exponent.stellen = 1) AND (exponent.zahl[1] = 0)) OR (exponent.stellen =
  1181. 0) THEN
  1182.                                             (* Exponent = 0 => Ergebnis = 1*)
  1183.   ELSE
  1184.     BEGIN
  1185.       ModCalcStr(basis, modul, hilfe1);       (* Divisionsrest Basis/Modul *)
  1186.       i := 1;                                    (* i mit 1 initialisieren *)
  1187.       WHILE (i <= (exponent.stellen - 1)) DO
  1188.         BEGIN
  1189.           wert := exponent.zahl[i];     (* Wert = i.te Stelle von Exponent *)
  1190.           j := 1;                                (* j mit 1 initialisieren *)
  1191.           WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
  1192.             BEGIN
  1193.               IF (wert AND 1) > 0 THEN          (* Falls Bit 1 gesetzt ist *)
  1194.                 BEGIN
  1195.                   MulModCalcStr(ergebnis, hilfe1, modul, hilfe);
  1196.                                             (* Ergebnis * Hilfe1 MOD Modul *)
  1197.                   ergebnis := hilfe;          (* und dem Ergebnis zuweisen *)
  1198.                 END;
  1199.               wert := wert SHR 1;               (* Wert durch 2 dividieren *)
  1200.               MulModCalcStr(hilfe1, hilfe1, modul, hilfe);
  1201.                                                 (* Hilfe1*Hilfe1 MOD Modul *)
  1202.               hilfe1 := hilfe;               (* und wieder Hilfe1 zuweisen *)
  1203.               INC(j);                                    (* j um 1 erhöhen *)
  1204.             END;
  1205.           INC(i);                                        (* 1 um 1 erhöhen *)
  1206.         END;
  1207.       wert := exponent.zahl[exponent.stellen];
  1208.                                         (* letzte Zahl gesondert behandeln *)
  1209.       WHILE (wert > 0) DO                  (* solange noch ein Bit gesetzt *)
  1210.         BEGIN
  1211.           IF (wert AND 1) > 0 THEN             (* Falls 1. Bit gesetzt ist *)
  1212.             BEGIN
  1213.               MulModCalcStr(ergebnis, hilfe1, modul, hilfe);
  1214.                                               (* Hilfe1*Ergebnis MOD Modul *)
  1215.               ergebnis := hilfe;              (* und dem Ergebnis zuweisen *)
  1216.             END;
  1217.           wert := wert SHR 1;                   (* Wert durch 2 dividieren *)
  1218.           MulModCalcStr(hilfe1, hilfe1, modul, hilfe);
  1219.                                                 (* Hilfe1*Hilfe1 MOD Modul *)
  1220.           hilfe1 := hilfe;                   (* und wieder hilfe1 zuweisen *)
  1221.         END;
  1222.     END;
  1223. END;
  1224.  
  1225. (* ----------------------------------------------------------------------- *)
  1226.  
  1227. BEGIN
  1228.  
  1229.   Randomize;                               (* Zufallsgenerator einschalten *)
  1230.  
  1231.   (* Initialiseren eines globalen Leerstrings *)
  1232.   WITH EMPTYCALCSTR DO                             (* Recordtyp abarbeiten *)
  1233.     BEGIN
  1234.       stellen := 0;                                         (* Länge ist 0 *)
  1235.       FOR i := 1 TO MAXCALCSTR DO zahl[i] := 0;     (* zahl initialisieren *)
  1236.     END;
  1237.   (* Ende der Initialisierung *)
  1238.  
  1239. END.
  1240.